home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tex / inputs / pslatex / makefonts.ps < prev    next >
Text File  |  1991-05-20  |  6KB  |  168 lines
  1. %!
  2. % PostScript code to generate derived fonts for PS-LaTeX
  3. %
  4. % Create a transformed font
  5. % params: symbol for name of new font,
  6. %         symbol for name of original font,
  7. %         font transformation matrix
  8. %         proc to execute on font (the transformed font dict is on the
  9. %               top of the stack when this proc is called)
  10. /TransformFont {
  11.   30 dict begin                 % for temporary storage
  12.     /Proc exch def              % the proc to exec
  13.     /TransformMatrix exch def   % transform matrix
  14.     /BaseName exch def          % existing font
  15.     /NewName exch def           % new name
  16.  
  17.         % find old font, apply transfrom
  18.     /BaseFontDict BaseName findfont TransformMatrix makefont def
  19.         % make a dictionary for the new font
  20.     /NewFont BaseFontDict maxlength dict def
  21.         % copy entries into the new dictionary (see Cookbook for expln.)
  22.     BaseFontDict
  23.       { exch dup /FID ne
  24.           { dup /Encoding eq
  25.               { exch dup length array copy
  26.                 NewFont 3 1 roll put }
  27.               { exch NewFont 3 1 roll put }
  28.             ifelse }
  29.           { pop pop }
  30.         ifelse
  31.       } forall
  32.     NewFont /FontName NewName put
  33.  
  34.         % call procedure
  35.     NewFont Proc
  36.         % store new font in fontdict
  37.     NewName NewFont definefont
  38.     pop
  39.   end
  40. } def
  41.  
  42. % Create an Oblique font
  43. % params:       new name for font
  44. %               old font
  45. %               angle of obliqueness
  46. /ObliqueFont {
  47.   20 dict begin
  48.     /Angle exch def
  49.     [1 0 Angle sin Angle cos div 1 0 0] % transform for obliqueness
  50.     {pop}
  51.     TransformFont
  52.   end
  53. } def
  54.  
  55. % SmallCapsFont - construct a "Small Caps" font for use by PS-Latex
  56. %Creator: Bob Tinkelman <bob@ccavax.camb.com>
  57. %      Cambridge Computer Associates, Inc.
  58. %      56 Beaver Street, 3rd floor
  59. %      New York, NY  10004  - USA
  60.  
  61. % This procedure is invoked with stack containing:
  62. %     /New-Font /Base-Font
  63. % It clears the stack and defines the new font /New-Font in terms
  64. % of the base font, /Base-Font
  65.  
  66. % Example of use:
  67. %    /Times-SmallCaps /Times-Roman SmallCapsFont
  68.  
  69. % The new font produces the same results as the base font except for "lower
  70. % case" letters (a-to-z).  For these, it outputs upper case (from the base
  71. % font) scaled by .8 in each dimension.  [This method of scaling was chosen,
  72. % in preference to the method recommended in the Blue Book (p157) only due
  73. % to the availability of corresponding TFM files in the PS-Latex distribution.]
  74.  
  75. /SmallCapsFont              % Stack: /New-Font,/Base-Font
  76. { 11 dict dup             % Stack: /New-Font,/Base-Font,dict,dict
  77.   3 1 roll            % Stack: /New-Font,dict,/Base-Font,dict
  78.   begin                % Make the new font be the current dictionary
  79.                 % Stack: /New-Font,dict,/Base-Font
  80.     findfont dup        % Find base font (leave /New-Font,dict on stack)
  81.     1000 scalefont        %   Scale it by 1000
  82.     /BaseFont-L exch def    %     and save as /BaseFont-L 
  83.     800 scalefont        %   Also scale it by 800 and 
  84.     /BaseFont-S exch def    %     and save as /BaseFont-S 
  85.                                 
  86.     /FontType 3 def                % 3 means "User defined"
  87.     /FontMatrix [.001 0 0 .001 0 0] def        % Scale by 1000 (see above)
  88.     /FontBBox BaseFont-L /FontBBox get def    % Copy bounding box
  89.     /Encoding BaseFont-L /Encoding get def    % Copy encoding 
  90.   
  91.     /TmpString 1 string def            % Storage for 1-char string
  92.     
  93.     /IsLowerCase                % See if char is a-z
  94.      {dup  (a) 0 get ge 
  95.       exch (z) 0 get le and
  96.      } def
  97.   
  98.     /ToUpperCase                % Convert lower to upper case
  99.      {dup IsLowerCase 
  100.       {(a) 0 get sub (A) 0 get add} if
  101.      } def
  102.   
  103.     /BuildChar                    % Stack: font, char
  104.      {exch begin                % font begin
  105.         BaseFont-L setfont            % Set to large basefont
  106.         dup IsLowerCase                % If char is a-z, then
  107.           {BaseFont-S setfont ToUpperCase}    %   reset font & convert to A-Z
  108.           if                    %
  109.         TmpString 0 3 -1 roll put        % put char into a temp string
  110.         TmpString stringwidth            % get width of current char
  111.         setcharwidth                % pass it to the font machinery
  112.         0 0 moveto                % BuildChar builds chars at 0,0
  113.         TmpString show                % output the temp string
  114.       end %font%                % font end
  115.      } def
  116.   
  117.   end %font dictionary
  118.  
  119.   definefont pop        % Define the font
  120.  
  121. } def % SmallCapsFont
  122.  
  123. % Create a condensed font with different strokewidth
  124. % params:       new font name
  125. %               old font name
  126. %               factor to condense by (e.g., 0.8)
  127. %               factor to thicken lines by (e.g., 1.5)
  128. /CondensedFont {
  129.   20 dict begin
  130.     /LineThickening exch def
  131.     /WidthNarrowing exch def
  132.     [WidthNarrowing 0 0 1 0 0] % transform matrix
  133.     {dup /StrokeWidth get LineThickening mul /StrokeWidth exch put}
  134.     TransformFont
  135.   end
  136. } def
  137.  
  138. % Create a Reduced font
  139. % params: new-name old-name scale
  140. /ReducedFont {
  141.   20 dict begin
  142.     /reduction exch def
  143.     [reduction 0 0 reduction 0 0]
  144.     {pop}         % no-op
  145.     TransformFont
  146.   end
  147. } def
  148.  
  149. /Times-Oblique /Times-Roman 15 ObliqueFont
  150. /Times-BoldOblique /Times-Bold 15 ObliqueFont
  151. %/Times-ItalicUnslanted /Times-Italic -15.15 ObliqueFont
  152. /Symbol-Oblique /Symbol 15 ObliqueFont
  153. /Times-SmallCaps /Times-Roman SmallCapsFont
  154. /Courier-Condensed /Courier 0.85 1.5 CondensedFont
  155. /Helvetica-Reduced /Helvetica 0.875 ReducedFont
  156.  
  157. % Can use these on a LaserWriter Plus
  158. /makeLWPlusFonts {
  159.   /Bookman-LightOblique /Bookman-Light 10 ObliqueFont
  160.   /Bookman-LightSmallCaps /Bookman-Light SmallCapsFont
  161.   /NewCenturySchlbk-Oblique /NewCenturySchlbk-Roman 10 ObliqueFont
  162.   /NewCenturySchlbk-SmallCaps /NewCenturySchlbk-Roman SmallCapsFont
  163.   /Palatino-SmallCaps /Palatino-Roman SmallCapsFont
  164.   /Palatino-Oblique /Palatino-Roman 10 ObliqueFont
  165.   /Palatino-BoldOblique /Palatino-Bold 10 ObliqueFont
  166. } def
  167.  
  168.